home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #148 (1991-11)(Rhein-Sieg-Soft).zip / Franz PD Disk #148 (1991-11)(Rhein-Sieg-Soft).adf / SnakyDATA / SNAKY < prev    next >
Text File  |  1991-11-09  |  7KB  |  256 lines
  1. CHDIR "SNAKYDATA"
  2. w=14:REM Hier Anzahl der LEVEL eingeben
  3. SCREEN 2,320,259,4,1
  4. WINDOW 2,"SNAKY         (C) 1990 by Thomas Mattel",(0,0)-(311,240),0,2
  5. DIM p%(67,22),b(18,12),c(80,1),d(18,12),u$(19),v(19),a(9,2,2)
  6. PALETTE 0,0,0,0:PALETTE 1,0,0,0:PALETTE 2,0,0,1:PALETTE 3,1,0,0
  7. GOSUB palon
  8.  
  9. FOR f=0 TO 3:FOR g=0 TO 2:READ a(f,g,0):NEXT g,f
  10. FOR f=0 TO 3:FOR g=0 TO 2:READ a(f,g,1):NEXT g,f
  11. FOR f=0 TO 3:FOR g=0 TO 2:READ a(f,g,2):NEXT g,f
  12. RESTORE
  13. FOR f=0 TO 3:FOR g=0 TO 2:READ a(f+4,g,0):NEXT g,f
  14. FOR f=0 TO 3:FOR g=0 TO 2:READ a(f+4,g,1):NEXT g,f
  15. FOR f=0 TO 3:FOR g=0 TO 2:READ a(f+4,g,2):NEXT g,f
  16.  
  17. FOR f=0 TO 16 STEP 2:LINE (8+f,10+f)-(306-f,180-f),4,b:NEXT f
  18. FOR f=0 TO 10 STEP 2:LINE (50+f,50-f)-(265-f,85+f),2,b:NEXT f
  19. FOR f=0 TO 10 STEP 2:LINE (30+f,120-f)-(285-f,140+f),3,b:NEXT f
  20. COLOR 7,0:LOCATE 9,18:PRINT "SNAKY"
  21. COLOR 11,0:LOCATE 17,8:PRINT "(C) 1990 by Thomas Mattel"
  22.  
  23. GOSUB loadgfx
  24. GOSUB loadhigh
  25. title:
  26. k=0:GOSUB loadlevel:FOR y=0 TO 12:FOR x=0 TO 18:b(x,y)=d(x,y):NEXT x,y
  27. CLS:GOSUB paloff:GOSUB prtlev:GOSUB palon
  28. COLOR 11,0:LOCATE 23,8:PRINT "PRESS BUTTON TO START GAME"
  29.  
  30. f=0
  31. wait1:
  32.   f=f+1:IF STRIG(3)=-1 THEN GOTO gamestart
  33.   IF f<3500 THEN GOTO wait1
  34.  
  35. GOSUB paloff:GOSUB prthigh
  36.   wait2:
  37. f=100:g=0
  38. wait3:
  39.   FOR x=0 TO 3
  40.   PALETTE 4+x,a(x+g,0,0),a(x+g,1,0),a(x+g,2,0)
  41.   PALETTE 8+x,a(x+g,0,1),a(x+g,1,1),a(x+g,2,1)
  42.   PALETTE 12+x,a(x+g,0,2),a(x+g,1,2),a(x+g,2,2)
  43.  
  44.   NEXT x:g=g+1+4*(g=4)
  45. FOR y=0 TO 190:NEXT y
  46.   f=f-1:IF STRIG(3) GOTO gamestart
  47.   IF f GOTO wait3
  48. GOTO title
  49.  
  50. gamestart: 
  51. CLS
  52. k=0:REM level
  53. j=1:REM 1 lives
  54. t=0:REM score
  55. i=0:REM time
  56.  
  57. nextlevel:
  58. j=j+1:k=k+1:t=t+i*10*j:IF k=15 THEN k=1
  59.   IF k>1 THEN
  60.   FOR g=500 TO 50 STEP -4:FOR f=1200 TO 100 STEP -g:SOUND f,.15,100,0:NEXT f,g
  61.   END IF
  62.  
  63. GOSUB loadlevel
  64.  
  65. restart2:
  66. i=o(0):REM time
  67. s=o(1):REM diamonds
  68. c(2,0)=o(2):c(2,1)=o(3):b(c(2,0),c(2,1))=17:REM koord kopf(aber code fuer body(17))
  69. c(1,0)=o(4):c(1,1)=o(5):b(c(1,0),c(1,1))=17:REM mittelteil
  70. c(0,0)=o(6):c(0,1)=o(7):b(c(0,0),c(0,1))=17:REM hinterteil (arsch)
  71. m=o(8):REM momentane richtung x
  72. n=o(9):REM momentane richtung y
  73. FOR y=0 TO 12:FOR x=0 TO 18:b(x,y)=d(x,y):NEXT x,y:REM level aus zwischenspeicher laden
  74. CLS:COLOR 3,0:LOCATE 26,10:PRINT "GET READY FOR LEVEL";k
  75. GOSUB paloff:GOSUB initanz:GOSUB prtanz:GOSUB prtlev:GOSUB palon
  76. FOR g=10 TO 40 STEP 2:FOR f=100+g*10 TO 400+g*10 STEP g:SOUND f,.15,100,1:NEXT f,g
  77. x=o(2):REM momentane koordinaten
  78. y=o(3):REM momentane koordinaten
  79.  
  80. init:
  81. ds=0:REM schwanz
  82. dk=2:REM kopf
  83. q=0:REM flag wenn 1 dann hinterteil nicht loeschen (wenn diamant gefressen)
  84. GOSUB initanz:REM anzeige initialisieren (score,level,timer...)
  85.  
  86. routine:
  87. GOSUB prtanz:REM momentane auzeigewerte
  88. REM FOR f=0 TO 300:NEXT f:REM warteschleife*********************************
  89. trainer2:
  90. i=i-1:IF i=-1 THEN GOTO livelost:REM timeout
  91. l1=STICK(2)
  92. l2=STICK(3)
  93. IF l1=-1 AND l2=0 AND (b(x-1,y)=0 OR b(x-1,y)>16) THEN n=0:m=-1
  94. IF l1=1 AND l2=0 AND (b(x+1,y)=0 OR b(x+1,y)>16) THEN n=0:m=1
  95. IF l1=0 AND l2=-1 AND (b(x,y-1)=0 OR b(x,y-1)>16) THEN m=0:n=-1
  96. IF l1=0 AND l2=1 AND (b(x,y+1)=0 OR b(x,y+1)>16) THEN m=0:n=1
  97.  
  98. REM delete last
  99. REM  IF q=1 THEN q=0:GOTO nodel    immer del,wenn dia geffr, dann last again
  100.   PUT (c(ds,0)*16,c(ds,1)*16),p%(0,0),PSET
  101.    b(c(ds,0),c(ds,1))=0:REM schwanzcode =0
  102. REM nachschieben
  103. REM nodel:
  104. dk=dk+1:IF dk=81 THEN dk=0
  105. ds=ds+1:IF ds=81 THEN ds=0
  106. REM  FOR f=d TO 1 STEP -1
  107. REM  c(f,0)=c(f-1,0)
  108. REM  c(f,1)=c(f-1,1)            
  109. REM  NEXT f
  110.  
  111. REM neue kopfpos
  112. kopfpos1:
  113. x=x+m:y=y+n
  114.   IF b(x,y)=22 THEN 
  115.     ds=ds-1:IF ds=-1 THEN ds=80
  116.     q=1:s=s-1:t=t+10
  117.     FOR f=100 TO 400 STEP 15:SOUND f,.15,100,0:NEXT f:GOTO kopfpos2
  118.     END IF:REM diamant-gefressen-routine
  119.     
  120.   IF b(x,y)=17 THEN LOCATE 22,17:GOTO livelost
  121.   IF b(x,y)>0 THEN x=x-m:y=y-n:GOSUB turn:GOTO kopfpos1
  122. kopfpos2:
  123.   b(x,y)=17:REM neue kopfpos in spielfekd-martix eintragen ald body!
  124.  c(dk,0)=x:c(dk,1)=y:REM neue kopfpos in wurmdatenschlange eintragen 
  125. REM kopf zeichnen
  126.   PUT ((x-m)*16,(y-n)*16),p%(0,17),PSET:REM alte kopfpos wird body 
  127.   PUT (x*16,y*16),p%(0,(18-(n=-1)-2*(m=1)-3*(n=1))),PSET:REM neue kopfpos
  128. REM endtest
  129.   IF s=0 THEN GOTO nextlevel
  130.  
  131. GOTO routine
  132.  
  133. turn:
  134. IF b(x,y-1)=0 OR b(x,y-1)=22 THEN m=0:n=-1:RETURN
  135. IF b(x-1,y)=0 OR b(x-1,y)=22 THEN n=0:m=-1:RETURN
  136. IF b(x,y+1)=0 OR b(x,y+1)=22 THEN m=0:n=1:RETURN
  137. IF b(x+1,y)=0 OR b(x+1,y)=22 THEN n=0:m=1:RETURN
  138.  
  139. IF m=1 THEN m=0:n=-1:RETURN
  140. IF n=-1 THEN n=0:m=-1:RETURN
  141. IF m=-1 THEN m=0:n=1:RETURN
  142. IF n=1 THEN n=0:m=1:RETURN
  143.  
  144. keywait:  IF INKEY$="" THEN GOTO keywait
  145. RETURN
  146.  
  147. trainer:
  148. livelost:
  149. j=j-1:FOR g=200 TO 10 STEP -10:FOR f=1000 TO 100 STEP-g:SOUND f,.15,100,1:NEXT f,g
  150. IF j=-1 THEN 
  151. CLS:LOCATE 8,14:COLOR 3,0:PRINT "Game Over !!"
  152. IF t<v(19) THEN 
  153.   COLOR 12,0:LOCATE 13,14:PRINT "NO HIGHSCORE"
  154.   FOR g=50 TO 400 STEP 5:FOR f=1000 TO 100 STEP -g:SOUND f,.15,100,0:NEXT f,g:GOTO title
  155.   END IF
  156.  
  157. COLOR 12,0:LOCATE 15,3:PRINT "Enter your name: ";:LINE INPUT g$
  158. IF LEN(g$)>12 THEN g$=LEFT$(g$,12)
  159. FOR f=19 TO 1 STEP -1
  160. IF v(f)<t THEN v(f)=v(f-1):u$(f)=u$(f-1)
  161. IF v(f)>t THEN v(f+1)=t:u$(f+1)=g$:GOSUB paloff:GOSUB prthigh:GOSUB savehigh:GOTO wait2
  162. NEXT f:v(0)=t:u$(0)=g$:GOSUB paloff:GOSUB prthigh:GOSUB savehigh:GOTO wait2
  163. END IF
  164.  
  165. GOTO restart2
  166.  
  167.  
  168. prtlev:REM routine prontet level auf screen
  169.   FOR y=0 TO 12:FOR x=0 TO 18:IF b(x,y)>0 THEN PUT (x*16,y*16),p%(0,b(x,y)),PSET
  170.   NEXT x,y
  171. RETURN
  172.  
  173. paloff:
  174.   FOR f=4 TO 15:PALETTE f,0,0,0:NEXT f
  175. RETURN
  176.  
  177. palon:
  178.   r=k-7*INT(k/7):IF r=0 THEN r=7
  179.   FOR f=4 TO 1 STEP-1:FOR g=0 TO 200:NEXT g
  180.   PALETTE f+3,f*.25*(r AND 1),f*.125*(r AND 2),f*.0625*(r AND 4):NEXT f
  181.  
  182.   PALETTE 8,0,.5,1
  183.   PALETTE 9,0,0,1
  184.   PALETTE 10,1,0,0
  185.   PALETTE 11,1,1,0
  186.   PALETTE 12,.6,0,.6
  187. RETURN
  188.  
  189. initanz:REM routine initialisiert die anzeige
  190.   COLOR 11,0:LOCATE 28,1:PRINT "Time:          ";
  191.   COLOR 12,0:PRINT "LEVEL";k;:COLOR 8,0:PRINT "   Diamonds:"
  192.   COLOR 3,0:LOCATE 29,1:PRINT "Lives:                    ";
  193.   COLOR 2,0:PRINT "Score:"
  194. RETURN
  195.  
  196. prtanz:REM routine printet anzeige
  197.   COLOR 11,0:LOCATE 28,7:PRINT i
  198.  
  199.   COLOR 8,0:LOCATE 28,36:PRINT s
  200.   COLOR 3,0:LOCATE 29,7:PRINT j
  201.   COLOR 2,0:LOCATE 29,33:PRINT t
  202.   RETURN
  203.  
  204. loadlevel:
  205.   n$=STR$(k):n$="levels/level_"+RIGHT$(n$,LEN(n$)-1)
  206.   OPEN n$ FOR INPUT AS #1
  207.   FOR f=0 TO 9:INPUT #1,o(f):NEXT f
  208.   FOR y=0 TO 12:FOR x=0 TO 18:INPUT #1,d(x,y):NEXT x,y:CLOSE #1
  209. RETURN
  210.  
  211. loadgfx:
  212.   OPEN "GFX" FOR INPUT AS #1
  213.   FOR y=0 TO 22:FOR x=0 TO 67:INPUT #1,p%(x,y):NEXT x,y:CLOSE #1
  214. RETURN
  215.  
  216. loadhigh:
  217.   OPEN "highscore" FOR INPUT AS #1
  218.   FOR f=0 TO 19:INPUT #1,u$(f):INPUT #1,v(f):NEXT f:CLOSE #1
  219. RETURN
  220.  
  221. savehigh:
  222.   OPEN "HighScore" FOR OUTPUT AS #1
  223.   FOR f=0 TO 19:PRINT #1,u$(f):PRINT #1,v(f):NEXT f:CLOSE #1
  224.   KILL "HighScore.info"
  225. RETURN
  226.  
  227. prthigh:
  228.   CLS:g$=" *************************************"
  229.   LOCATE 1,1:g=3
  230.   FOR f=1 TO 38:COLOR 8+g,0:PRINT MID$(g$,f,1);:g=g-1-4*(g=0):NEXT f 
  231.   LOCATE 2,1:x=0:y=1
  232.   FOR f=0 TO 24:COLOR 11-x,0:PRINT " *";SPACE$(35);:COLOR 8+y,0:PRINT "*":x=x-1-4*(x=0):y=y-1-4*(y=0):NEXT f
  233.   LOCATE 27,1:g=3
  234.   FOR f=1 TO 38:COLOR 8+g,0:PRINT MID$(g$,f,1);:g=g+1+4*(g=3):NEXT f 
  235.   LOCATE 3,14:g=3
  236.   FOR f=1 TO 13:COLOR 12+g,0:PRINT MID$("Best Snakers:",f,1);:g=g-1-4*(g=0):NEXT f 
  237.   COLOR 8,0:g=3
  238.   FOR f=0 TO 19:g=g-1-4*(g=0):LOCATE 6+f,9+(f>8):COLOR 4+g,0:PRINT STR$(f+1);". ";u$(f);TAB(27);v(f):NEXT f
  239. RETURN
  240.  
  241. DATA 1,.8,.8
  242. DATA 1,.6,.6
  243. DATA 1,.4,.4
  244. DATA 1,.2,.2
  245.  
  246. DATA 0,0,.7
  247. DATA 0,1,0
  248. DATA .8,0,.6
  249. DATA 1,1,0
  250.  
  251. DATA 0,.6,1
  252. DATA 0,.5,.8
  253. DATA 0,.4,.6
  254. DATA 0,.3,.5
  255.  
  256.